home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / TCPExample / TCPExample.p < prev    next >
Encoding:
Text File  |  1992-12-10  |  2.9 KB  |  89 lines  |  [TEXT/PJMM]
  1. program KenExampleCode;
  2.  
  3. { You can do anything you want with this code - if you can make any money out of it, you'll be doing well! }
  4.  
  5.     uses
  6.         TCPTypes, TCPStuff, TCPConnections;
  7.  
  8.     const
  9.         user_name = 'peter';
  10.         dest_name = 'cujo.curtin.edu.au';
  11.         dest_port = 79;
  12.         nul = chr(0);
  13.         lf = chr(10);
  14.         cr = chr(13);
  15.  
  16.     var
  17.         oe: OSErr;
  18.         cp: connectionIndex;
  19.         quitNow: boolean;
  20.         cer: connectionEventRecord; { Event record for TCP events, simmilar to EventRecord }
  21.         s: str255;
  22.         count: longInt;
  23.         gotlinefeed: boolean;
  24. begin
  25.     ShowText;
  26.     quitNow := false;
  27.     oe := InitConnections; { Startup the TCP units }
  28.     if oe = noErr then begin
  29.         oe := FindAddress(cp, dest_name, nil);
  30.         if oe = noErr then begin
  31.             count := 0;
  32.             while not quitNow do begin
  33.                 if GetConnectionEvent(any_connection, cer) then begin { Get the next TCP event }
  34.                     case cer.event of
  35.                         C_Found:  begin
  36.                             writeln('Found ', dest_name, ' has address ', pointer(cer.value));
  37.                             oe := NewActiveConnection(cp, Default_TCPBUFFERSIZE, cer.value, dest_port, nil);
  38. { Open an active connection to the Finger port on dest_name }
  39.                         end;
  40.                         C_SearchFailed:  begin
  41.                             writeln('Couldn''t fine the address for ', dest_name);
  42.                             quitNow := true;
  43.                         end;
  44.                         C_Established:  begin { Happens once per succesful connection establishment }
  45.                             writeln('Connection Established');
  46.                             s := concat(user_name, cr, lf); { Send the line that finger wants, complete with crlf }
  47.                             oe := TCPSend(cer.tcpc, @s[1], length(s), true);
  48.                             writeln('Name sent with error ', oe);
  49.                             if oe <> noErr then
  50.                                 CloseConnection(cp); { Better close the connection if we can't send anything to it! }
  51.                         end;
  52.                         C_FailedToOpen: 
  53.                             writeln('Ooops, connection failed to open... Error is ', cer.value, ' Timed out is ', cer.timedout);
  54. { Example, network unreachable etc.  Error code is in cer.value }
  55.                         C_Closing:  begin
  56.                             writeln('Connection closing');{ Gets called when the connection starts closing down}
  57.                             CloseConnection(cer.connection); { Close our side of the connection }
  58.                         end;
  59.                         C_Closed:  begin
  60.                             writeln('Connection closed, quit now');
  61.                             quitNow := true; { The connection is closed, quit the program }
  62.                         end;
  63.                         C_CharsAvailable:  begin
  64. {$PUSH}
  65. {$R-}
  66.                             oe := TCPReceiveUpTo(cer.tcpc, 10, 60, @s[1], 255, count, gotlinefeed);
  67. { Recieve characters up to a line feed }
  68.                             if (count > 0) & (s[count] = lf) then { strip off linefeed }
  69.                                 count := count - 1;
  70.                             if (count > 0) & (s[count] = cr) then { strip off cr }
  71.                                 count := count - 1;
  72.                             s[0] := chr(count);
  73. {$POP}
  74.                             if gotlinefeed then begin { if we got a linefeed, print the string, otherwise go round again and wait for more characters }
  75.                                 writeln(s);
  76.                                 count := 0;
  77.                             end;
  78.                         end;
  79.                     end;
  80.                 end;
  81.             end;
  82.         end;
  83.         FinishEverything; { Close everything, clean up }
  84. { ALWAY CALL THIS, OR YOU WILL BE SORRY! }
  85.     end;
  86.     writeln('Click to quit');
  87.     while not Button do
  88.         ;
  89. end.